home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d10 / ps1410.arc / CAL5.BAS < prev    next >
BASIC Source File  |  1990-10-31  |  68KB  |  1,844 lines
  1.     '=========================================================================
  2.     ' Personal Calendar (PC) Program
  3.     '  Copyright (c) 1985-1990, Paul Munoz-Colman.  All Rights Reserved.
  4.     '    Version 14.10
  5.     '     31 Oct 1990
  6.     '    Shareware $25
  7.     '=========================================================================
  8.     '              DOS File CAL5.BAS
  9.     '  Independently Compiled Subprograms Which Are Linked With CAL1.BAS
  10.     '=========================================================================
  11.     '  Written For IBM PCs & Compatibles Under MS DOS 3.30 on a Northgate 486
  12.     '   Compiled By Microsoft Professional BASIC 7.10, Linker Version 5.10
  13.     '=========================================================================
  14.     '  Note -- Tabs in the source file are in positions 6,11,16,21,26,...
  15.     '=========================================================================
  16.     ' $INCLUDE: 'cal1.bi'
  17.     '=========================================================================
  18.     '  Subprogram List in the Order of Appearance in this File
  19.     '   (compiled WITHOUT error handling--no /E or /X)
  20.     '-------------------------------------------------------------------------
  21.     '    Name                          Purpose
  22.     '    ---------------------------   ---------------------------------------
  23.     '    PoppedOverCheck               Check to See Whether Popped Over DOS
  24.     '    PrepareforError               Clear and Place for Error Message
  25.     '    PrepareforFatal               Prepare for QuickBASIC Error Message
  26.     '    PrepareforMessage             Clear and Place for Info Message
  27.     '    PrintCalendar                 Display Three Months of Calendars
  28.     '    PrintCopy                     Print or Copy Appointments to ASCII File
  29.     '    ProcessAlarm                  Update Event and History Upon Alarm
  30.     '    PutApptRecord (Pointer)       Put Records in Appt File (Blank if 0)
  31.     '    QuickSort (SortLow, SortHigh)    Sort Alarm Table Routine
  32.     '    QuitLine                      Ctl-ESC to Quit Instruction
  33.     '    QuitLineDelete                Ctl-ESC to Quit Instruction
  34.     ' Fn RandInt (Lower, Upper)        Random integer from lower to upper
  35.     '    ReadCalauto                   Read Auto Start CALAUTO.DAT File
  36.     '    ReadCalDOS                    Read DOS Command CALDOS.DAT File
  37.     '    ReadCalexcl                   Read Exclusion CALEXCL.DAT File
  38.     '    ReadCalfig                    Read Colors CALFIG.DAT File
  39.     '    ReadCalmusic                  Read CALMUSIC.DAT File
  40.     '    ReadCalres                    Read CALRES.DAT File
  41.     '    RefreshEventsNotes            Display Clock Screen Footer
  42.     '    RepackApptRecord              Build Event Record From Fields
  43.     '    RestoreCalKeyState            Restore State of Ins,Caps,Num,Scrl
  44.     '    RestoreDOSKeyState            Restore State of DOS Ins,Caps,Num,Scrl
  45.     '    ReturnLine                    Enter Instruction
  46.     '    ReturnLineDelete              Enter Instruction Blank Out
  47.     '    SaveCurrentDirectory (EntryPoint)
  48.     '                                  Get Program or User Directory
  49.     '    SaveDOSKeyState               Save State of DOS Ins,Caps,Num,Scrl
  50.     '    ScreenBottoms                 Esc, Quit, and Return Instructions
  51.     '    ScreenBottomsDelete           Esc, Quit, and Return Instructions Blank
  52.     '    SequenceEventsTable           Resort Events Listing
  53.     '    SetArrays                     Set Array Sizes Based Upon Event File
  54.     '    SetColors                     Color Choice Menus
  55.     '    SetCurrentDirectory (EntryPoint)
  56.     '                                  Change to Current or User Directory
  57.     '=========================================================================
  58.     SUB PoppedOverCheck STATIC
  59.     '=========================================================================
  60.     DEFINT A-Z
  61.         SubnumSave = Subnum
  62.         Subnum = 52
  63.     '  Check to see Whether Program Is Popped Up Over the DOS Prompt or
  64.     '   Over another Program.  Can't remove from memory or SrResidentShell
  65.     '   Unless Popped Up Over DOS
  66.     PoppedUpOverProgram = No
  67.     PoppedUpOverDOS = No
  68.     IF MemoryResident THEN
  69.         IF SrOverDOS% THEN                '** SRP4
  70.             PoppedUpOverDOS = Yes        '** SRP4
  71.           ELSE                        '** SRP4
  72.             PoppedUpOverProgram = Yes    '** SRP4
  73.         END IF                        '** SRP4
  74.     END IF
  75.         Subnum = SubnumSave
  76.     END SUB
  77.     '=========================================================================
  78.     SUB PrepareforError STATIC
  79.     '=========================================================================
  80.     DEFINT A-Z
  81.         SubnumSave = Subnum
  82.         Subnum = 53
  83.     CALL ClearScreenNormal(N1)
  84.     CALL MajorBeeper
  85.     CALL Kolors(N14)
  86.     CALL BlankError
  87.         Subnum = SubnumSave
  88.     END SUB
  89.     '=========================================================================
  90.     SUB PrepareforFatal STATIC
  91.     '=========================================================================
  92.     DEFINT A-Z
  93.         SubnumSave = Subnum
  94.         Subnum = 54
  95.     CALL ClearScreenNormal(N1)
  96.     CALL MajorBeeper
  97.     CALL Kolors(N14)
  98.     CALL BlankFatal
  99.         Subnum = SubnumSave
  100.     END SUB
  101.     '=========================================================================
  102.     SUB PrepareforMessage STATIC
  103.     '=========================================================================
  104.     DEFINT A-Z
  105.         SubnumSave = Subnum
  106.         Subnum = 55
  107.     CALL MinorBeeper
  108.     CALL Kolors(N14)
  109.     CALL BlankError
  110.         Subnum = SubnumSave
  111.     END SUB
  112.     '=========================================================================
  113.     SUB PrintCalendar STATIC
  114.     '=========================================================================
  115.     '   Display Calendars (PrintCalendar)
  116.     DEFINT A-Z
  117.         SubnumSave = Subnum
  118.         Subnum = 56
  119.     '-------------------------------------------------------------------------
  120.     '  If Printing Report, Make Two Passes, One to Generate Calendars, and
  121.     '   Another To Return Them To The CalendarDate$ In Memory, If Necessary
  122.     PrintPass$ = False$
  123.     IF PrintingReport THEN
  124. PassEntry:
  125.         IF PrintPass$ = "2" THEN GOTO ExitPoint
  126.         IF PrintPass$ = "1" THEN
  127.             IF TodaysDate$ = HoldWhilePrinting$ OR FirstTimeClock = Yes THEN
  128.                 GOTO ExitPoint
  129.             END IF
  130.             PrintPass$ = "2"              ' Restore Calendar Arrays to
  131.             CalendarDate$ = HoldWhilePrinting$ '  Whatever They Were
  132.         END IF
  133.         IF PrintPass$ = False$ THEN
  134.             PrintPass$ = "1"
  135.             HoldWhilePrinting$ = MemoryDate$
  136.             CalendarDate$ = TodaysDate$
  137.         END IF
  138.     END IF
  139.     '-------------------------------------------------------------------------
  140.     '  If Calendars In Memory, Don't Recompute
  141.     '   Calendars In Memory--Check If Printing or Timer In Case Resequenced
  142.     IF MemoryDate$ = CalendarDate$ THEN     'Wrong Date Recomputes
  143.         ' Right Date/Printing Skips
  144.         IF PrintPass$ = "1" THEN GOTO ShowCalendars         
  145.         ' Right Date/Time Skips
  146.         IF MemoryTime! = TimerSave! THEN GOTO ShowCalendars 
  147.     END IF
  148.     '-------------------------------------------------------------------------
  149.     '  Not in Memory, So Recompute Calendar Values
  150.     MemoryTime! = TIMER
  151.     TimerSave! = MemoryTime!
  152.     MemoryDate$ = CalendarDate$
  153.     CalendarYear = VAL(MID$(CalendarDate$, N1, N4))
  154.     CalendarMonth = VAL(MID$(CalendarDate$, N5, N2))
  155.     CalendarDay = VAL(MID$(CalendarDate$, N7, N2))
  156.     CalendarMonths(N2) = CalendarMonth
  157.     CalendarYears(N2) = CalendarYear
  158.     '-------------------------------------------------------------------------
  159.     '           Months And Years For Prior and Next Calendar
  160.     SELECT CASE CalendarMonth
  161.         '--------------------------------------------------------------------
  162.         CASE 1                        '  Middle Month is January
  163.             CalendarMonths(N1) = N12
  164.             IF CalendarYear > N0 THEN
  165.                 CalendarYears(N1) = CalendarYear - N1
  166.               ELSE
  167.                 CalendarYears(N1) = 9999
  168.             END IF
  169.             CalendarMonths(N3) = CalendarMonth + N1
  170.             CalendarYears(N3) = CalendarYear
  171.         '--------------------------------------------------------------------
  172.         CASE 2 TO N11                  '  Middle Month is February to November
  173.             CalendarMonths(N1) = CalendarMonth - N1
  174.             CalendarYears(N1) = CalendarYear
  175.             CalendarMonths(N3) = CalendarMonth + N1
  176.             CalendarYears(N3) = CalendarYear
  177.         '--------------------------------------------------------------------
  178.         CASE N12                       '  Middle Month is December
  179.             CalendarMonths(N1) = CalendarMonth - N1
  180.             CalendarYears(N1) = CalendarYear
  181.             CalendarMonths(N3) = N1
  182.             IF CalendarYear < 9999 THEN
  183.                 CalendarYears(N3) = CalendarYear + N1
  184.               ELSE
  185.                 CalendarYears(N3) = N0
  186.             END IF
  187.         '--------------------------------------------------------------------
  188.     END SELECT
  189.     '-------------------------------------------------------------------------
  190.     '  Determine the First Week Day of Each Month
  191.     '-------------------------------------------------------------------------
  192.     FOR MonthIndex = N1 TO N3
  193.         CALL YearAdjust(CalendarYears(MonthIndex), AdjustedYear$)
  194.         DatetoIndex$ = ZeroFill$(AdjustedYear$ + _
  195.             RIGHT$(STR$(CalendarMonths(MonthIndex)), N2) + "01")
  196.         CALL DayDate(DatetoIndex$)
  197.         FirstDays(MonthIndex) = IndexedDay
  198.     NEXT
  199.     '-------------------------------------------------------------------------
  200.     CalendarImage(N1) = Blank80$
  201.     '           Store And Display
  202.     '-------------------------------------------------------------------------
  203.     FOR MonthIndex = N1 TO N3
  204.         '--------------------------------------------------------------------
  205.         IF MonthIndex = N2 THEN ColumnOffset = N17 ELSE ColumnOffset = N22
  206.         '  Year Of Middle Month-Centered
  207.         '--------------------------------------------------------------------
  208.         MonthnameStart = CalendarColumns(MonthIndex) + (ColumnOffset - _
  209.             LEN(MonthNames$(CalendarMonths(MonthIndex)))) \ N2
  210.         MonthnameLength = LEN(MonthNames$(CalendarMonths(MonthIndex)))
  211.         '  Month Name
  212.         '--------------------------------------------------------------------
  213.         IF MonthIndex <> N2 THEN 
  214.             CALL Myd2(CalendarImage(N1), MonthnameStart, MonthnameLength, _
  215.                 (MonthNames$(CalendarMonths(MonthIndex))))
  216.         END IF
  217.         MonthnameStart = CalendarColumns(MonthIndex) + (ColumnOffset - _
  218.             LEN(MonthNames$(CalendarMonths(MonthIndex)))) \ N2
  219.         CALL YearAdjust(CalendarYears(N2), AdjustedYear$)
  220.         AdjustedYear$ = ZeroFill$(AdjustedYear$)
  221.         MonthnameLength = LEN(MonthNames$(CalendarMonths(MonthIndex)) + _
  222.             Blank1$ + AdjustedYear$)
  223.         IF MonthIndex = N2 THEN 
  224.             CALL Myd2(CalendarImage(N1), MonthnameStart, MonthnameLength, _
  225.           (MonthNames$(CalendarMonths(MonthIndex)) + Blank1$ + AdjustedYear$))
  226.         END IF
  227.         '           Month Name,Year
  228.         '--------------------------------------------------------------------
  229.     NEXT
  230.     '-------------------------------------------------------------------------
  231.     CalendarImage(N2) = Blank80$
  232.     '           Day Labels
  233.     '-------------------------------------------------------------------------
  234.     FOR MonthIndex = N1 TO N3
  235.         FOR DayPlacement = N1 TO N7
  236.             CALL Myd2(CalendarImage(N2), N1 + _
  237.                 CalendarColumns(MonthIndex) + N3 * (DayPlacement - N1), _
  238.                 N2, DayNames$(DayPlacement))
  239.         NEXT DayPlacement
  240.     NEXT MonthIndex
  241.     '-------------------------------------------------------------------------
  242.     FOR I = N1 TO N6
  243.         CalendarImage(N2 + I) = Blank80$
  244.     NEXT
  245.     '-------------------------------------------------------------------------
  246.     IF ApptFile THEN
  247.         AlarmPointer = N1
  248.         AlarmsAvailable = Yes
  249.         LightTable = N1
  250.         FOR I = N1 TO N2 * NumberofEvents
  251.             LightDay(I) = N0
  252.         NEXT
  253.     END IF
  254.     '-------------------------------------------------------------------------
  255.     FOR MonthIndex = N1 TO N3
  256.     CALL KeyStuff(KeyStatus)
  257.         '  Days
  258.         LeapReturn = Leap(CalendarYears(MonthIndex))
  259.         IF CalendarMonths(MonthIndex) = N2 AND LeapReturn = N1 THEN
  260.             EndingDay = 29
  261.           ELSE
  262.             EndingDay = MonthLength(CalendarMonths(MonthIndex))
  263.         END IF
  264.         '           Leap Year Goes To 29
  265.         FirstDayOfWeek = FirstDays(MonthIndex)
  266.         '           Starting Day
  267.         '--------------------------------------------------------------------
  268.         FOR WhichDay = N1 TO EndingDay
  269.             '---------------------------------------------------------------
  270.             WhichRow = (FirstDayOfWeek - N1) \ N7
  271.             '           Line To Display The Day On
  272.             DayOfWeekPosition = FirstDayOfWeek MOD N7
  273.             IF DayOfWeekPosition = N0 THEN DayOfWeekPosition = N7
  274.             DayOfWeekPosition = DayOfWeekPosition * N3 - N3
  275.             DayToShow$ = BlankFill$(RIGHT$(STR$(WhichDay), N2))
  276.             '---------------------------------------------------------------
  277.             '           Hor Offset
  278.             CALL Myd2(CalendarImage(N3 + WhichRow), N1 + _
  279.                 CalendarColumns(MonthIndex) + DayOfWeekPosition, _
  280.                 N2, DayToShow$)
  281.             '---------------------------------------------------------------
  282.             '           Store The Day In The Display Line
  283.             IF ApptFile AND AlarmsAvailable THEN
  284.                 SELECT CASE Alarms(AlarmPointer).Alarm
  285.                     CASE IS = 0#
  286.                         AlarmsAvailable = No
  287.                     CASE ELSE
  288. AlarmDayStore:
  289.                         DaycalTest& = CalendarYears(MonthIndex) * 10000& _
  290.                             + CalendarMonths(MonthIndex) * 100& + WhichDay
  291.                         DaytableTest& = _
  292.                             FIX(Alarms(AlarmPointer).Alarm / 10000&)
  293.                         SELECT CASE DaytableTest&
  294.                             CASE IS < DaycalTest&
  295.                                 AlarmPointer = AlarmPointer + N1
  296.                                 IF AlarmPointer <= NumberofEvents THEN 
  297.                                     GOTO AlarmDayStore
  298.                                 END IF
  299.                                 AlarmsAvailable = No
  300.                             CASE IS = DaycalTest&
  301.                                 LightDay(LightTable) = N1 + WhichRow
  302.                                 LightDay(LightTable + N1) = _
  303.                                     CalendarColumns(MonthIndex) + _
  304.                                     DayOfWeekPosition
  305.                                 LightTable = LightTable + N2
  306.                         END SELECT
  307.                 END SELECT
  308.             END IF
  309.             '---------------------------------------------------------------
  310.             IF MonthIndex = N2 AND WhichDay = CalendarDay THEN
  311.                 HilitRow = WhichRow + N2
  312.                 '  Hilit Day
  313.                 HilitColumn = CalendarColumns(MonthIndex) + _
  314.                     DayOfWeekPosition
  315.                 HilitDay$ = DayToShow$
  316.                 TodayBright = N0
  317.                 IF ApptFile AND ((NormalCalendars AND OverdueCount) OR _
  318.                               (DaycalTest& <> 0& AND _
  319.                                DaycalTest& = DaytableTest&)) THEN 
  320.                     TodayBright = N1
  321.                 END IF
  322.             END IF
  323.             FirstDayOfWeek = FirstDayOfWeek + N1
  324.         NEXT WhichDay
  325.         '--------------------------------------------------------------------
  326.         IF WhichDay = 29 AND LeapReturn = N1 THEN
  327.             WhichRow = (FirstDayOfWeek - N1) \ N7
  328.             '  Vertical Offset For Leap Year Day
  329.             DayOfWeekPosition = FirstDayOfWeek MOD N7
  330.             IF DayOfWeekPosition = N0 THEN DayOfWeekPosition = N7
  331.             DayOfWeekPosition = DayOfWeekPosition * N3 - N3
  332.             '  Hor Offset
  333.             CALL Myd2(CalendarImage(N3 + WhichRow), N1 + _
  334.                 CalendarColumns(MonthIndex) + DayOfWeekPosition, N3, "29")
  335.         END IF
  336.     NEXT MonthIndex
  337.     '-------------------------------------------------------------------------
  338.     '   Recompute Finished
  339.     '-------------------------------------------------------------------------
  340.     '   Display Calendars
  341. ShowCalendars:
  342.     IF PrintPass$ = "1" THEN           ' Calendars From Print or Copy
  343.         FOR I = N1 TO N8
  344.             CALL KeyStuff(KeyStatus)
  345.             IF PrintorCopy$ = "p" AND CalendarImage(I) <> Blank80$ THEN
  346.                 CALL LprintString(SPACE$(N5) + _
  347.                     LEFT$(CalendarImage(I), N70), N0)
  348.                 IF LprintTerminate THEN GOTO ExitPoint
  349.             END IF
  350.             IF PrintorCopy$ = "w" AND CalendarImage(I) <> Blank80$ THEN
  351.                 PRINT #FilenumCopy, SPACE$(N5); LEFT$(CalendarImage(I), N70)
  352.             END IF
  353.         NEXT
  354.     END IF
  355.     IF PrintingReport THEN GOTO PassEntry
  356.         CSRow = CalendarStartRow + N1
  357.         CSColumn = CalendarStartColumn + N1
  358.         CSColumn2 = CSColumn + CalendarColumns(N2)
  359.         ShowString$ = LEFT$(CalendarImage(N1), N70)
  360.     CALL ShowIt(N4, CSRow, CSColumn, ShowString$)
  361.         ShowString$ = MID$(CalendarImage(N1), N1 + CalendarColumns(N2), N20)
  362.     CALL ShowIt(N11, N0, CSColumn2, ShowString$)
  363.         ShowString$ = LEFT$(CalendarImage(N2), N70)
  364.     CALL ShowIt(N4, Nm1, CSColumn, ShowString$)
  365.     '-------------------------------------------------------------------------
  366.     '   Display Calendar Lines On Screen and Highlight If Called For
  367.     FOR CalendarRow = N1 TO N6
  368.         CALL KeyStuff(KeyStatus)
  369.             CSRow = CalendarStartRow + N2 + CalendarRow
  370.             CSColumn = CalendarStartColumn + N1
  371.             ShowString$ = LEFT$(CalendarImage(N2 + CalendarRow), N70)
  372.         CALL ShowIt(N4, CSRow, CSColumn, ShowString$)
  373.         IF ApptFile THEN
  374.             FOR LightTable = N1 TO Nm1 + N2 * NumberofEvents STEP N2
  375.                 IF LightDay(LightTable) = N0 OR _
  376.                    LightDay(LightTable) > CalendarRow THEN 
  377.                     EXIT FOR
  378.                 END IF
  379.                 YSave = LightDay(LightTable)           'Array Row
  380.                 CSRow = YSave + CalendarStartRow + N2    'Screen Row
  381.                 XSave = LightDay(LightTable + N1)       'Array Column
  382.                 CSColumn = XSave + CalendarStartColumn + N1 ' Screen Column
  383.                 ShowString$ = MID$(CalendarImage(N2 + YSave), _
  384.                     N1 + XSave, N2)
  385.                 CALL ShowIt(N11, CSRow, CSColumn, ShowString$)
  386.             NEXT LightTable
  387.         END IF
  388.     NEXT CalendarRow
  389.     '-------------------------------------------------------------------------
  390.         CSRow = CalendarStartRow + HilitRow + N1
  391.         CSColumn = CalendarStartColumn + HilitColumn + N1
  392.     CALL ShowErase(N4, CSRow, CSColumn, N3, Blank0$)
  393.     IF NOT ApptFile OR TodayBright = N0 THEN
  394.         CALL Kolors(N7)
  395.       ELSE
  396.         CALL Kolors(N14)
  397.     END IF
  398.     CALL ShowIt(N0, N0, N0, HilitDay$)
  399.     CALL DayDate(CalendarDate$)
  400.         J = IndexedDay
  401.         CSRow = CalendarStartRow + N2
  402.         ShowString$ = LEFT$(DayNames$(J), N2)
  403.     CALL ShowIt(N0, CSRow, ScreenColumn, ShowString$)
  404.     '  Hilit Today's Date and Day of the Week
  405.     RedisplayCalendars = No
  406. ExitPoint:
  407.         Subnum = SubnumSave
  408.     END SUB
  409.     '=========================================================================
  410.     SUB PrintCopy STATIC
  411.     '=========================================================================
  412.     '   Print or Copy Appointment File To DOS File
  413.     DEFINT A-Z
  414.         SubnumSave = Subnum
  415.         Subnum = 57
  416.     '-------------------------------------------------------------------------
  417.     PrintingReport = Yes
  418.     IF ClockScreenPrint THEN GOTO StartPrint
  419.         '--------------------------------------------------------------------
  420.         '           Print/Copy File
  421.         DirectReturn = Yes
  422.         ' Clear Line 25
  423.         CALL ShowErase(N6, N25, N1, N80, Blank0$)
  424.         CALL DisplayApptFilename
  425.         IF PrintorCopy$ <> "p" THEN
  426.             '---------------------------------------------------------------
  427.             CopyFilename$ = SPACE$(N12)
  428.             CALL Myd2(CopyFilename$, N1, LEN(ApptFilename$), ApptFilename$)
  429.             CALL Myd2(CopyFilename$, InString(CopyFilename$, Blank1$), _
  430.                 N4, ".asc")
  431.             CALL ControlledInput(N25, N28, N25, N8, N12, _
  432.                 "Name of ASCII File", CopyFilename$, N0, N1, N1, N1)
  433.             IF Keystroke$ = CHR$(Esc) THEN
  434.                 CALL ClearScreenNormal(N1)
  435.                 GOTO AllOver
  436.             END IF
  437.             '---------------------------------------------------------------
  438.             CLOSE FilenumCopy
  439.             OPEN "O", FilenumCopy, CopyFilename$, N80
  440.           ELSE
  441. StartPrint:
  442.             CALL InitPrinter
  443.             If LprintTerminate THEN GOTO TerminatePrint
  444.         END IF
  445.     IF NOT ClockScreenPrint THEN
  446.         CALL Kolors(N14)
  447.         CALL BlankError
  448.         IF PrintorCopy$ = "p" THEN
  449.             CALL ShowIt(N0, N0, N0, "Printing Appointments")
  450.           ELSE
  451.             CALL ShowIt(N0, N0, N0, _
  452.                 ("Generating ASCII File " + CopyFilename$))
  453.         END IF
  454.     END IF
  455.     '-------------------------------------------------------------------------
  456.     CALL GetFilenameLength
  457.     DisplayFilename$ = LEFT$(ApptFilename$, FilenameLength)
  458.     GOSUB DoubleEqualLine
  459.     Buffer80$ = DayNames$(TodaysDay) + ", " + DATE$ + SPACE$(N2) + _
  460.         TIME$ + "               " + DisplayFilename$ + _
  461.         "'s Appointment Calendar"
  462.     GOSUB PrintALine
  463.     '-------------------------------------------------------------------------
  464.     GOSUB DoubleEqualLine
  465.     CALL PrintCalendar                      ' Calendars Before Events
  466.     '-------------------------------------------------------------------------
  467.     GOSUB DoubleEqualLine
  468.     Buffer80$ = "Events (" + RIGHT$(STR$(EventsScheduled), N3) + ")"
  469.     GOSUB PrintALine
  470.     GOSUB DoubleEqualLine
  471.     '-------------------------------------------------------------------------
  472.     '  Initialize Counter For Week Break Logic
  473.     PreviousIndexedDay = N0
  474.     FOR I = N1 TO NumberofEvents
  475.         WhichEvent = I
  476.         CALL ApptToMenu(N1)
  477.         CALL KeyStuff(KeyStatus)
  478.         IF CurrentEventRecord$ <> Blank80$ THEN
  479.             '----------------------------------------------------------------
  480.             '           Write Events
  481.             '  If No Week Break Wanted, Skip Break Logic
  482.             IF WeekBreak$ = True$ THEN
  483.                 '----------------------------------------------------------
  484.                 '  Compute Whether Week Break Needed
  485.                 '   Get New Day of Week and Day Count
  486.                 DatetoIndex$ = MID$(CurrentEventRecord$, N74, N2) + _
  487.                     LEFT$(CurrentEventRecord$, N6)
  488.                 CALL DayDate(DatetoIndex$)
  489.                 CurrentIndexedDay = IndexedDay
  490.                 CurrentCountedDay& = CountedDay&
  491.                 '----------------------------------------------------------
  492.                 '   If First Time Through, Initialize Comparison Holders
  493.                 IF PreviousIndexedDay = N0 THEN
  494.                     GOSUB SaveDayCounts               '  Save Day Counts
  495.                     '-----------------------------------------------------
  496.                     '   If New Day of Week More Than 7 Beyond Old,
  497.                     '     Or Not Later In Week
  498.                   ELSEIF CurrentIndexedDay < PreviousIndexedDay OR _
  499.                        (CurrentCountedDay& - _
  500.                         PreviousCountedDay&) >= 7&             THEN
  501.                     GOSUB SingleEqualLine          '  Generate Week Breaker
  502.                     GOSUB SaveDayCounts          '  Save Day Counts
  503.                 END IF
  504.                 '----------------------------------------------------------
  505.             END IF
  506.             '  Generate Event Line
  507.             Buffer80$ = CurrentEventLine$
  508.             GOSUB PrintALine
  509.         END IF
  510.     NEXT
  511.     '-------------------------------------------------------------------------
  512.     IF InclNotes THEN
  513.         '           Write Notes
  514.         GOSUB DoubleEqualLine
  515.         Buffer80$ = "Notes"
  516.         GOSUB PrintALine
  517.         GOSUB DoubleEqualLine
  518.         FOR I = N1 TO NumberofNotes
  519.             CALL KeyStuff(KeyStatus)
  520.             Pointer = StartingNote + I - N1
  521.             CALL GetApptRecord(Pointer)
  522.             Buffer80$ = ApptBuffer$
  523.             IF Buffer80$ <> Blank80$ THEN
  524.                 IF PrintorCopy$ = "p" THEN    ' Don't number on a copy
  525.                     CALL MhMidString(Buffer80$, N6%, N75%, _
  526.                         ApptBuffer$, N1%)
  527.                     MID$(Buffer80$, N1, N5) = SPACE$(N5)
  528.                     MID$(Buffer80$, N1, N5) = STR$(I)
  529.                 END IF
  530.                 GOSUB PrintALine
  531.             END IF
  532.         NEXT
  533.     END IF
  534.     IF InclHistory THEN
  535.         '           Write History
  536.         GOSUB DoubleEqualLine
  537.         Buffer80$ = "History (" + STR$(LOF(FilenumAppt) \ N80 - _
  538.             StartingHistory + N1) + ")"
  539.         GOSUB PrintALine
  540.         GOSUB DoubleEqualLine
  541.         FOR I = StartingHistory TO LOF(FilenumAppt) \ N80
  542.             CALL KeyStuff(KeyStatus)
  543.             CALL GetApptRecord(I)
  544.             Buffer80$ = ApptBuffer$
  545.             IF Buffer80$ <> Blank80$ THEN GOSUB PrintALine
  546.         NEXT
  547.     END IF
  548.     PrintingReport = No
  549.     IF NOT ClockScreenPrint THEN
  550.         CALL ClearScreenNormal(N1)
  551.         CALL Kolors(N14)
  552.         CALL BlankError
  553.         Menu1 = MainMenuLastEntry
  554.         IF PrintorCopy$ = "w" THEN
  555.             GOSUB DoubleEqualLine
  556.             CLOSE FilenumCopy
  557.             CALL ShowIt(N0, N0, N0, _
  558.                 ("Completed Generation of ASCII File " + CopyFilename$))
  559.             GOTO AllOver
  560.         END IF
  561.     END IF
  562.     CALL PageEject
  563.     LprintJobOver = Yes
  564.     CALL LprintString(Blank0$, N0)
  565.     If LprintTerminate THEN GOTO TerminatePrint
  566.     IF NOT ClockScreenPrint THEN
  567.         CALL BlankError
  568.         CALL ShowIt(N0, N0, N0, ("Completed Print Generation for " + _
  569.             ApptFilename$))
  570.     END IF
  571.     GOTO AllOver
  572. DoubleEqualLine:
  573.     Buffer80$ = Strng$(N80, 61)            'Main Separator (equals)
  574.     GOSUB PrintALine
  575.     RETURN
  576. SingleEqualLine:
  577.     Buffer80$ = Strng$(N80, N45)            'Week Breaker (hyphens)
  578.     GOSUB PrintALine
  579.     RETURN
  580. PrintALine:
  581.     CALL KeyStuff(KeyStatus)
  582.     Buffer80$ = RTRIM$(Buffer80$)
  583.     IF PrintorCopy$ = "p" THEN
  584.         CALL LprintString(Buffer80$, N0)    ' Generate Print
  585. TerminatePrint:
  586.         IF LprintTerminate THEN
  587.             LprintTerminate = No
  588.             PrintPass$ = False$
  589.             PrintingReport = No
  590.             IF NOT ClockScreenPrint THEN
  591.                 CALL Kolors(N14)
  592.                 CALL BlankError
  593.                 CALL ShowIt(N0, N0, N0, _
  594.                     "Print Generation Terminated by Request")
  595.                 CALL Kolors(N6)
  596.                 CALL ClearLast3
  597.             END IF
  598.             GOTO AllOver
  599.         END IF
  600.       ELSE
  601.         PRINT #FilenumCopy, Buffer80$ ' Generate Record
  602.     END IF
  603.     RETURN
  604.     '  Save Day Counts for Comparison
  605. SaveDayCounts:
  606.     PreviousIndexedDay = CurrentIndexedDay
  607.     PreviousCountedDay& = CurrentCountedDay&
  608.     RETURN
  609. AllOver:
  610.     ClockScreenPrint = No
  611.     LprintTerminate = No
  612.         Subnum = SubnumSave
  613.     END SUB
  614.     '=========================================================================
  615.     SUB ProcessAlarm STATIC
  616.     '=========================================================================
  617.     '   Alarm Ringing, Reschedule Recurring Events, Resequence Table &
  618.     '          Fill Overdue Table With Late Events
  619.     '=========================================================================
  620.     DEFINT A-Z
  621.         SubnumSave = Subnum
  622.         Subnum = 58
  623.     EventTableStable = No
  624.     OPEN "R", #FilenumOverdue, ApptFilenameOverdue$, N80
  625.     FIELD #FilenumOverdue, N80 AS OverdueBuffer$
  626.     FOR AlarmTableIndex = N1 TO NumberofEvents
  627.         CALL KeyStuff(KeyStatus)
  628.         '--------------------------------------------------------------------
  629.         '  Flag for Rescheduling Bi/Multi/Weeklies or Special Monthlies
  630.         Rescheduling = No
  631.         '   Check Each Event For Lateness -- Not Null and Overdue
  632.         IF Alarms(AlarmTableIndex).Alarm <> 0# AND _
  633.            Alarms(AlarmTableIndex).Alarm <= CurrentDateTime# THEN
  634.             CALL ShowErase(N14, N25, N1, N80, (SPACE$(N19) + _
  635.    "Please Wait--Checking Overdue Event" + STR$(AlarmTableIndex) + SPACE$(N4)))
  636.             '---------------------------------------------------------------
  637.             '  Late Event To End of Overdue Table, Alarm Entry Gets Cleared
  638.             Alarms(AlarmTableIndex).Alarm = 0#
  639.             OverdueCount = LOF(FilenumOverdue)\N80 + N1
  640.             WhichEvent = AlarmTableIndex
  641.             CALL ApptToMenu(N1)
  642.             CALL MhLset(OverdueBuffer$, CurrentEventLine$)
  643.             PUT #FilenumOverdue, OverdueCount
  644.             '---------------------------------------------------------------
  645.             '   If Entry Is Not Null, Then Write It To History
  646.             IF CurrentEventLine$ <> Blank80$ AND _
  647.                CurrentEventLine$ <> NullEvent$ THEN
  648.                 EventtoHistory = Yes
  649.                 HistoryBuffer$ = CurrentEventLine$
  650.                 CALL WritetoHistory
  651.             END IF
  652.             '---------------------------------------------------------------
  653.             ' If Entry Is Daily, Bi/Multi/Weekly, Monthly, Quarter/Yearly
  654.             '  Then Reschedule It
  655.             LimitedsLeft = VAL(MID$(CurrentEventRecord$, N68, N2))
  656.             IF MID$(CurrentEventRecord$, N70, N1) = Blank1$ OR _
  657.                LimitedsLeft = N1 THEN
  658.                 '----------------------------------------------------------
  659.                 ' If Entry Is One-Time or Last Recurring, Blank It Out
  660.                 CurrentEventRecord$ = Blank80$
  661.                 CurrentEventLine$ = Blank80$
  662.               ELSE
  663.                 '           Recurring With Last Time Blanks Out
  664.                 '----------------------------------------------------------
  665.                 '   Decrement The Recurring Item Count if There
  666.                 IF LimitedsLeft > N0 THEN
  667.                     CALL Myd2(CurrentEventRecord$, N68, N2, _
  668.                         (RIGHT$(STR$(LimitedsLeft - N1), N2)))
  669.                 END IF
  670.                 '----------------------------------------------------------
  671.                 ' Rebuild The Menu Entry For That Item
  672.                 '  And Rewrite Event Record
  673.                 WhichEvent = AlarmTableIndex   'On 2 or more or
  674.                 CALL UnpackApptRecord          ' unlimited
  675.                 CALL CombineDateTime
  676.                 Rescheduling = Yes
  677.                 CALL ValidateEventDate
  678.                 CALL RepackApptRecord
  679.                 CALL BuildMenuLine
  680.             END IF
  681.             CALL MhLset(ApptBuffer$, CurrentEventRecord$)
  682.             CALL PutApptRecord(N1 + AlarmTableIndex)
  683.         END IF
  684.     NEXT
  685.     CLOSE #FilenumOverdue
  686.     '-------------------------------------------------------------------------
  687.     '   Resequence The Event Table
  688.     CALL SequenceEventsTable
  689.     '-------------------------------------------------------------------------
  690.     '   Reprint Calendars, Notes and Events On Display
  691.     CALL PrintCalendar
  692.     CALL RefreshEventsNotes
  693.         Subnum = SubnumSave
  694.     END SUB
  695.     '=========================================================================
  696.     SUB PutApptRecord (Pointer) STATIC
  697.     '=========================================================================
  698.     '  Put a Record To the Appointment File
  699.     '   If a Null String Then Replace it by Blanks
  700.     DEFINT A-Z
  701.         SubnumSave = Subnum
  702.         Subnum = 59
  703.     IF NOT ApptFile THEN CALL OpenAppts
  704.     IF ApptBuffer$ = ZeroLine THEN    ' Replace Null Record
  705.         CALL MhLset(ApptBuffer$, Blank80$)
  706.     END IF
  707.     PUT FilenumAppt, Pointer
  708.         Subnum = SubnumSave
  709.     END SUB
  710.     '========================================================================
  711. DEFINT A-Z
  712.     SUB QuickSort (SortLow, SortHigh)
  713.     '========================================================================
  714.     DEFINT A-Z
  715.         SubnumSave = Subnum
  716.         Subnum = 134
  717.     '=========================================================================
  718.     ' QuickSort is adapted here from QB 4.50 Examples File SORTDEMO.BAS.
  719.     '=========================================================================
  720.     ' QuickSort works by picking a random "pivot" element in Alarms, then
  721.     ' moving every element that is bigger to one side of the pivot, and every
  722.     ' element that is smaller to the other side.  QuickSort is then called
  723.     ' recursively with the two subdivisions created by the pivot.  Once the
  724.     ' number of elements in a subdivision reaches two, the recursive calls end
  725.     ' and the array is sorted.
  726.     '=======================================================================
  727.     IF SortLow < SortHigh THEN
  728.            ' Only two elements in this subdivision; swap them if they are out of
  729.            ' order, then end recursive calls
  730.         IF SortHigh - SortLow = N1 THEN
  731.             IF Alarms(SortLow).Alarm > Alarms(SortHigh).Alarm THEN
  732.                 SWAP Alarms(SortLow), Alarms(SortHigh)
  733.                END IF
  734.           ELSE
  735.                ' Pick a pivot element at random, then move it to the end
  736.                RandIndex = RandInt(SortLow, SortHigh)
  737.             SWAP Alarms(SortHigh), Alarms(RandIndex)
  738.                Partition = Alarms(SortHigh).Alarm
  739.                DO
  740.                   ' Move in from both sides towards the pivot element:
  741.                   I = SortLow
  742.                 J = SortHigh
  743.                   DO WHILE (I < J) AND (Alarms(I).Alarm <= Partition)
  744.                     I = I + N1
  745.                   LOOP
  746.                   DO WHILE (J > I) AND (Alarms(J).Alarm >= Partition)
  747.                     J = J - N1
  748.                   LOOP
  749.                   ' If we haven't reached the pivot element, it means that two
  750.                   ' elements on either side are out of order, so swap them:
  751.                   IF I < J THEN
  752.                     SWAP Alarms(I), Alarms(J)
  753.                   END IF
  754.                 LOOP WHILE I < J
  755.                 ' Move the pivot element back to its proper place in the array:
  756.                 SWAP Alarms(I), Alarms(SortHigh)
  757.                 ' Recursively call the QuickSort procedure (pass the smaller
  758.                 ' subdivision first to use less stack space):
  759.                 IF (I - SortLow) < (SortHigh - I) THEN
  760.                   QuickSort SortLow, I - N1
  761.                   QuickSort I + N1, SortHigh
  762.                ELSE
  763.                 QuickSort I + N1, SortHigh
  764.                   QuickSort SortLow, I - N1
  765.                 END IF
  766.         END IF
  767.     END IF
  768.         Subnum = SubnumSave
  769.     END SUB
  770.     '=========================================================================
  771.     SUB QuitLine STATIC
  772.     '=========================================================================
  773.     DEFINT A-Z
  774.         SubnumSave = Subnum
  775.         Subnum = 60
  776.     CALL QuitLineDelete
  777.     CALL ShowIt(N7, N25, N62, " Ctl-Esc ")
  778.     CALL ShowIt(N6, N0, Nm1, "Quit")
  779.         Subnum = SubnumSave
  780.     END SUB
  781.     '=========================================================================
  782.     SUB QuitLineDelete STATIC
  783.     '=========================================================================
  784.     DEFINT A-Z
  785.         SubnumSave = Subnum
  786.         Subnum = 61
  787.     CALL ShowErase(N6, N25, N62, N19, Blank0$)
  788.         Subnum = SubnumSave
  789.     END SUB
  790.     '=======================================================================
  791.     FUNCTION RandInt%(Lower%, Upper%)  STATIC
  792.     '=======================================================================
  793.     '   Returns a random integer greater than or equal to the Lower parameter
  794.     '   and less than or equal to the Upper parameter.
  795.     '=======================================================================
  796.     DEFINT A-Z
  797.         SubnumSave = Subnum
  798.         Subnum = 135
  799.     RandInt = INT(RND * (Upper - Lower + N1)) + Lower
  800.         Subnum = SubnumSave
  801.     END FUNCTION
  802.     '=========================================================================
  803.     SUB ReadCalauto STATIC
  804.     '=========================================================================
  805.     '   Read (Or Write) Automatic Startup File
  806.     DEFINT A-Z
  807.         SubnumSave = Subnum
  808.         Subnum = 110
  809.     UpdatingCalauto = No
  810.     IF NOT FileExist("calauto.dat") THEN
  811.         UpdatingCalauto = Yes
  812.       ELSE
  813.         ErrorSwitch = No
  814.         NewGuy = No                        ' File Exists, Read It
  815.         OPEN "I", #FilenumAuto, "calauto.dat"
  816.         CALL ReadCalautoGet                ' with error handling in CAL1
  817.         IF ErrorSwitch THEN                ' Check for short record
  818.             ErrorSwitch = No
  819.             UpdatingCalauto = Yes
  820.         END IF
  821.     END IF
  822.     CLOSE FilenumAuto
  823.     IF AutoMode$ = True$ AND NOT EarlyPopDownFailed THEN    ' If attempt for TSR
  824.         AutostartMode = Yes                    ' fails before initialization
  825.       ELSE                                ' is complete, don't do
  826.         AutoStarted = No                    ' automatic startup
  827.         AutostartMode = No
  828.         EarlyPopDownFailed = No
  829.     END IF
  830.     IF AutostartMode THEN                ' If okay then copy password
  831.         EnteredPassword$ = ApptPassword$
  832.       ELSE
  833.         ApptPassword$ = Blank8$
  834.         ApptFilename$ = Blank8$
  835.     END IF
  836.     ' If a filename, let it alone, else set it to blanks with password
  837.     IF LEN(ApptFilename$) <> N8 THEN
  838.         ApptFilename$ = Blank8$
  839.     END IF
  840.     IF ApptFilename$ = Blank8$ THEN
  841.         ApptPassword$ = Blank8$
  842.         EnteredPassword$ = ApptPassword$
  843.     END IF
  844.     IF UpdatingCalauto THEN
  845.          CALL WriteCalauto                  'Create or update auto start file
  846.     END IF
  847.         Subnum = SubnumSave
  848.     END SUB
  849.     '=========================================================================
  850.     SUB ReadCalDOS STATIC
  851.     '=========================================================================
  852.     '   Read (Or Write) DOS Command for F7
  853.     DEFINT A-Z
  854.         SubnumSave = Subnum
  855.         Subnum = 111
  856.     IF NOT FileExist("caldos.dat") THEN
  857.         CALL Snooze(0.7!)
  858.          CALL PrepareforMessage
  859.         CALL ShowIt(N0, N0, N0, _
  860.             " Created Prestored DOS Command File CALDOS.DAT")
  861.       ELSE
  862.         NewGuy = No
  863.         ErrorSwitch = No
  864.         OPEN "I", FilenumDOS, "caldos.dat"
  865.         CALL ReadCalDOSGet            ' with error handling in main
  866.         IF NOT ErrorSwitch THEN
  867.             CLOSE FilenumDOS
  868.             EXIT SUB
  869.         END IF
  870.     END IF
  871.     DOSCommand$ = Blank80$
  872.     CLOSE FilenumDOS
  873.     CALL WriteCalDOS                   'Create DOS Command File
  874.         Subnum = SubnumSave
  875.     END SUB
  876.     '=========================================================================
  877.     SUB ReadCalexcl STATIC
  878.     '=========================================================================
  879.     '  Read (or Write) Text Exclusions From History
  880.     DEFINT A-Z
  881.         SubnumSave = Subnum
  882.         Subnum = 112
  883.     IF NOT FileExist("calexcl.dat") THEN 'Read Entry (Write only if problems)
  884.         ErrorSwitch = Yes
  885.         CALL Snooze(0.7!)
  886.         CALL PrepareforMessage
  887.         CALL ShowIt(N0, N0, N0, _
  888.             " Created Event Exclusion From History File CALEXCL.DAT")
  889.       ELSE
  890.         NewGuy = No
  891.         ErrorSwitch = No
  892.         OPEN "I", FilenumExcl, "calexcl.dat"
  893.         CALL ReadCalexclGet        ' with error handling in CAL1
  894.         CLOSE FilenumExcl
  895.     END IF
  896.     IF ErrorSwitch THEN CALL WriteCalexcl
  897.     ErrorSwitch = No
  898.         Subnum = SubnumSave
  899.     END SUB
  900.     '=========================================================================
  901.     SUB ReadCalfig STATIC
  902.     '=========================================================================
  903.     '   Read (Or Write) Color Choice File
  904.     DEFINT A-Z
  905.         SubnumSave = Subnum
  906.         Subnum = 113
  907.     Writefig = N0
  908.     UpdatingCalfig = No
  909.     IF NOT FileExist("calfig.dat") THEN 'Read Entry (Write only if problems)
  910.         UpdatingCalfig = Yes
  911.         Writefig = N1
  912.       ELSE
  913.         NewGuy = No
  914.         OPEN "I", FilenumFig, "calfig.dat"
  915.         ErrorSwitch = No
  916.         CALL ReadCalfigGet        ' with error handling in CAL1
  917.         CLOSE FilenumFig
  918.         IF ErrorSwitch THEN       ' Reading Past End Of File
  919.             UpdatingCalfig = Yes     '  Those Variables Which Existed
  920.             Writefig = N1             '  Are Still In Memory -- The
  921.             ErrorSwitch = No
  922.         END IF                        '  Writing of CALFIG.DAT Will Fill
  923.     END IF                        '   in missing parameters
  924.     '====================================================================
  925.     IF Writefig = N1 THEN CALL WriteCalfig
  926.         Subnum = SubnumSave
  927.     END SUB
  928.     '=========================================================================
  929.     SUB ReadCalmusic STATIC
  930.     '=========================================================================
  931.     '   Read (Or Write) Music Choice File For Alarms and Chimes
  932.     DEFINT A-Z
  933.         SubnumSave = Subnum
  934.         Subnum = 114
  935.     IF NOT FileExist("calmusic.dat") THEN 'Read Entry (Write only if problems)
  936.         CALL Snooze(0.7!)
  937.         ErrorSwitch = Yes
  938.         CALL PrepareforMessage
  939.         CALL ShowIt(N0, N0, N0, _
  940.             " Created Music Choices File CALMUSIC.DAT")
  941.       ELSE
  942.         NewGuy = No
  943.         ErrorSwitch = No
  944.         OPEN "I", FilenumMusic, "calmusic.dat"
  945.         CALL ReadCalmusicGet        ' with error handling in CAL1
  946.         CLOSE FilenumMusic
  947.     END IF
  948.     IF ErrorSwitch THEN
  949.         ErrorSwitch = No
  950.         IF LEN(Alarm$) = N0 THEN
  951.             Alarm$ = Blank80$
  952.             CALL Myd2 (Alarm$, N1, N58, "mb t255 ml o4 f9d9f9d9f9d" + _
  953.                    "9f9d9f9d9 ms a9a9a9a9a9a9a9a9a9a9 t60 p2")
  954.         END IF
  955.         IF LEN(Chime$) = N0 THEN
  956.             Chime$ = Blank80$
  957.             CALL Myd2 (Chime$, N1, N32, _
  958.                 "mb o2 ms l5 t70 bgad p2 dabg p2 t45")
  959.         END IF
  960.         IF LEN(Warning$) = N0 THEN
  961.             Warning$ = Blank80$
  962.             CALL Myd2 (Warning$, N1, N58, "mb t255 ml o2 f9d9f9d9f" + _
  963.                 "9d9f9d9f9d9 ms a9a9a9a9a9a9a9a9a9a9 t60 p2")
  964.         END IF
  965.         CALL WriteCalmusic
  966.     END IF
  967.         Subnum = SubnumSave
  968.     END SUB
  969.     '=========================================================================
  970.     SUB ReadCalres STATIC
  971.     '=========================================================================
  972.     '   Read (Or Write) Stay-Res Options File
  973.     DEFINT A-Z
  974.         SubnumSave = Subnum
  975.         Subnum = 115
  976.     WriteRes = N0
  977.     UpdatingCalres = No
  978.     IF NOT FileExist("calres.dat") THEN 'Read Entry (Write only if problems)
  979.         WriteRes = N1
  980.       ELSE
  981.         NewGuy = No
  982.         ErrorSwitch = No
  983.         OPEN "I", FilenumRes, "calres.dat"
  984.         CALL ReadCalresGet        ' with error handling in CAL1
  985.         CLOSE FilenumFig
  986.         IF ErrorSwitch THEN
  987.             WriteRes = N1
  988.         END IF
  989.     END IF
  990.     '--------------------------------------------------------------------
  991.     '   Set Stay-Res Defaults and Internal Values as Needed
  992.     '====================================================================
  993.     '  Fill In Whichever Options Are Missing
  994.     IF EverResident$ = True$ THEN
  995.         SrOptionsChosen = Yes
  996.       ELSE
  997.         SrOptionsChosen = No
  998.         EverResident$ = False$
  999.     END IF
  1000.     IF UserPopDateTime$ = False$ THEN
  1001.         AllowPopDateTime = No
  1002.       ELSE
  1003.         UserPopDateTime$ = True$
  1004.         AllowPopDateTime = Yes
  1005.     END IF
  1006.     IF UseEMS$ = True$ THEN
  1007.         SrDontUseEMS = No
  1008.       ELSE
  1009.         UseEMS$ = False$
  1010.         SrDontUseEMS = Yes
  1011.     END IF
  1012.     IF NOT SrSnowCheck THEN
  1013.         CALL SrNoSnow
  1014.     END IF
  1015.     IF UseDiskSwap$ = True$ THEN
  1016.         SrDiskSwapping = Yes
  1017.       ELSE
  1018.         UseDiskSwap$ = False$
  1019.         SrDiskSwapping = No
  1020.     END IF
  1021.     ' Path for "swap" files is calendar's directory
  1022.     IF SrSwapPath$ = Blank0$ OR NOT DirectoryExist(SrSwapPath$) THEN
  1023.         WriteRes = Yes
  1024.         SrSwapPath$ = ReturnPath$
  1025.     END IF
  1026.     IF SrKscanHot = N0 AND SrKshiftHot = N0 THEN
  1027.         SrKscanHot = 103         ' Ctrl-Lshift-F10 is default hot key
  1028.         SrKshiftHot = N6
  1029.     END IF
  1030.     ' Get English Name of Defined Hot Key       
  1031.     CALL StayResKeyName
  1032.     ' Write File If Not Read Properly
  1033.     IF WriteRes THEN
  1034.         UpdatingCalres = Yes
  1035.         CALL WriteCalres
  1036.     END IF
  1037.     ErrorSwitch = No
  1038.         Subnum = SubnumSave
  1039.     END SUB
  1040.     '=========================================================================
  1041.     SUB RefreshEventsNotes STATIC
  1042.     '=========================================================================
  1043.     '   Refresh Event And Notes On Clock Display Page
  1044.     DEFINT A-Z
  1045.         SubnumSave = Subnum
  1046.         Subnum = 63
  1047.     FromOverduePage = No
  1048.     SELECT CASE FooterSize
  1049.         CASE 5, N9
  1050.             FooterStartLine = N15
  1051.         CASE 3, N4, 8
  1052.             FooterStartLine = N16
  1053.         CASE 6, 7
  1054.             FooterStartLine = N17
  1055.     END SELECT
  1056.     '           Refresh
  1057.     IF FooterRecall THEN FooterAction$ = Blank1$      'Footer Recall
  1058.     IF NoteSize <> N0 AND FooterAction$ <> "e" THEN
  1059.         '           Notes
  1060.         FOR I = N1 TO NoteSize
  1061.             CALL KeyStuff(KeyStatus)
  1062.             Pointer = I + CurrentNote + StartingNote - N2
  1063.             CALL GetApptRecord(Pointer)
  1064.             FooterRow = FooterStartLine + I + N1
  1065.             IF FooterRow > N21 AND FooterRecall THEN
  1066.                 RefreshInstructions = Yes
  1067.                 FooterRecall = No
  1068.             END IF
  1069.             WindowLine$ = Blank80$
  1070.             ' Get Note Number and Right Justify It
  1071.             EditLineLabel$ = STR$(CurrentNote - N1 + I)
  1072.             LenTemp = LEN(EditLineLabel$) - N1  ' Less the leading space
  1073.             IF LenTemp > N3 THEN LenTemp = N3    ' Only the right 3 chars
  1074.             CALL Myd2(WindowLine$, N1, N3, (SPACE$(N3 - LenTemp) + _
  1075.                 RIGHT$(EditLineLabel$, LenTemp)))
  1076.             CALL Myd2(WindowLine$, N6, N75, ApptBuffer$)
  1077.             IF ColorCRT THEN
  1078.                 CALL Kolors(N9)
  1079.               ELSE
  1080.                 CALL Kolors(N7)
  1081.             END IF
  1082.             CALL ShowIt(N0, FooterRow, N1, WindowLine$)
  1083.         NEXT
  1084.     END IF
  1085.     IF OverdueCount THEN
  1086.         IF OverdueCount > FooterSize - NoteSize THEN
  1087.             CALL ShowOverduePage
  1088.             FromOverduePage = Yes
  1089.             GOTO ExitPoint2
  1090.         END IF
  1091.         IF SoundLevel > N2 AND NOT AlarmMusicPlayed THEN
  1092.             CALL PlayAlarmWarning(N0)
  1093.         END IF
  1094.         AlarmMusicPlayed = Yes
  1095.         OPEN "R", #FilenumOverdue, ApptFilenameOverdue$, N80
  1096.         FIELD #FilenumOverdue, N80 AS OverdueBuffer$
  1097.         FOR I = N1 TO OverdueCount
  1098.             CALL KeyStuff(KeyStatus)
  1099.             GET #FilenumOverdue, I
  1100.             FooterRow = FooterStartLine + NoteSize + I + N1
  1101.             IF FooterRow > N21 AND FooterRecall THEN
  1102.                 RefreshInstructions = Yes
  1103.                 FooterRecall = No
  1104.             END IF
  1105.             WindowLine$ = OverdueBuffer$
  1106.             CALL ShowIt(N16, FooterRow, N1, WindowLine$)
  1107.         NEXT
  1108.         CLOSE #FilenumOverdue
  1109.     END IF
  1110.     IF OverdueCount <> FooterSize - NoteSize AND FooterAction$ <> False$ THEN
  1111.         '           Earliest Events
  1112.         '           Skip Blank
  1113.         WindowSize = FooterSize - NoteSize - OverdueCount
  1114.         FOR I = N1 TO WindowSize
  1115.             WhichEvent = (CurrentEvent - N1 + I)
  1116.             '  Compute Event Table Index, Make Blink if a Warning
  1117.             FooterRow = FooterStartLine + NoteSize + OverdueCount + I + N1
  1118.             IF I = N1 THEN
  1119.                 EventWindowStart = FooterRow
  1120.             END IF
  1121.             IF FooterRow > N21 AND FooterRecall THEN
  1122.                 RefreshInstructions = Yes
  1123.                 FooterRecall = No
  1124.             END IF
  1125.             CALL ApptToMenu(N1)
  1126.             EventWindow(I) = CurrentEventLine$
  1127.         NEXT
  1128.         FOR I = N1 to WindowSize
  1129.             IF Pending = N0 THEN
  1130.                 CALL Kolors(N8)
  1131.               ELSE
  1132.                 WhichEvent = (CurrentEvent - N1 + I)
  1133.                 IF PendingEvents(WhichEvent) = N0 THEN
  1134.                     CALL Kolors(N8)
  1135.                   ELSE
  1136.                     ColorForeground = Cl1b + N16
  1137.                     ColorBackground = Cl1f
  1138.                     CALL Kolors(N0)
  1139.                 END IF
  1140.             END IF
  1141.             CALL ShowIt(N0, (EventWindowStart + I - N1), _
  1142.                 N1, EventWindow(I))
  1143.         NEXT
  1144.     END IF
  1145.     RedisplayNotesEvents = No
  1146. ExitPoint2:
  1147.         Subnum = SubnumSave
  1148.     END SUB
  1149.     '=========================================================================
  1150.     SUB RepackApptRecord STATIC
  1151.     '=========================================================================
  1152.     '   Repack Appointment File Record From Individual Variables
  1153.     DEFINT A-Z
  1154.         SubnumSave = Subnum
  1155.         Subnum = 64
  1156.     CALL Myd2(EventYear1st2$, N1%, N2%, EventDate$)
  1157.     CALL MhMidString(EventYear$, N1%, N2%, EventDate$, N3%)
  1158.     CALL MhMidString(EventMonth$, N1%, N2%, EventDate$, N5%)
  1159.     CALL MhMidString(EventDay$, N1%, N2%, EventDate$, N7%)
  1160.     CALL Myd2(EventHour$, N1%, N2%, EventTime$)
  1161.     CALL MhMidString(EventMinute$, N1%, N2%, EventTime$, N3%)
  1162.     CALL Myd2(CurrentEventRecord$, N1%, N2%, EventYear$)
  1163.     CALL Myd2(CurrentEventRecord$, N3%, N2%, EventMonth$)
  1164.     CALL Myd2(CurrentEventRecord$, N5%, N2%, EventDay$)
  1165.     CALL Myd2(CurrentEventRecord$, N7%, N2%, EventHour$)
  1166.     CALL Myd2(CurrentEventRecord$, N9%, N2%, EventMinute$)
  1167.     CALL Myd2(CurrentEventRecord$, N11%, TextSize%, EventText$)
  1168.     CALL Myd2(CurrentEventRecord$, N68%, N2%, EventLimRepeat$)
  1169.     CALL Myd2(CurrentEventRecord$, N70%, N3%, EventRepeat$)
  1170.     CALL Myd2(CurrentEventRecord$, N74%, N2%, EventYear1st2$)
  1171.         Subnum = SubnumSave
  1172.     END SUB
  1173.     '=========================================================================
  1174.     SUB RestoreCalKeyState STATIC
  1175.     '=========================================================================
  1176.     '  Restore Keys to Last State in This Program
  1177.     DEFINT A-Z
  1178.         SubnumSave = Subnum
  1179.         Subnum = 66
  1180.     '  It is safe to use BASIC LOCATE here, because we're in the calendar
  1181.     '   and in text mode.
  1182.     IF CursorState THEN            ' Turn the Cal cursor on, if appropriate
  1183.         ' If the cursor is within limits, show it.
  1184.         IF CursorRow > N0 AND CursorColumn > N0 AND _
  1185.               CursorRow <= DisplayRows AND CursorColumn <= DisplayColumns THEN
  1186.             LOCATE CursorRow, CursorColumn, CursorState, _
  1187.                 CursorStart, CursorStop
  1188.         END IF
  1189.     END IF
  1190.     CALL MhSetKbStatus(Insrt%, Caps%, Num%, Scroll%)  ' Restore Key States
  1191.         Subnum = SubnumSave
  1192.     END SUB
  1193.     '=========================================================================
  1194.     SUB RestoreDOSKeyState STATIC
  1195.     '=========================================================================
  1196.     '  Restore DOS Keys to Original State
  1197.     DEFINT A-Z
  1198.         SubnumSave = Subnum
  1199.         Subnum = 67
  1200.     ' Restore the user cursor if there is one
  1201.     '  It isn't safe to use LOCATE here, because we're in the user's underlying
  1202.     '   video mode, so we use a direct DOS BIOS call.
  1203.     InterruptNumber% = &H10            ' ROM-BIOS Video Services Interrupt
  1204.     AH% = &H01                    ' Set Cursor Size
  1205.     CL% = DOSCursorStop                ' Set the user bottom scan line
  1206.     CH% = DOSCursorStart            ' Set the user top scan line
  1207.     IF DOSCursorState THEN              ' If cursor was on
  1208.         CH% = CH% OR N32            '   turn on bit 5
  1209.       ELSE
  1210.         CH% = CH% AND NOT N32        '   else turn it off
  1211.     END IF
  1212.     GOSUB DOSBIOS
  1213.     '
  1214.     InterruptNumber% = &H10            ' ROM-BIOS Video Services Interrupt
  1215.     AH% = &H02                    ' Set Cursor Position function
  1216.     BH% = DOSCursorPage                '  Set the user video page
  1217.     DH% = DOSCursorRow                '  Set the user cursor row
  1218.     DL% = DOSCursorColumn            '  Set the user cursor column
  1219.     GOSUB DOSBIOS
  1220.     ' Restore the state of the Insert, Caps, Num, and Scroll keys
  1221.     CALL MhSetKbStatus(InsertDOS%, CapsDOS%, NumDOS%, ScrollDOS%)
  1222.         Subnum = SubnumSave
  1223.     EXIT SUB
  1224. DOSBIOS:
  1225.     CALL DOSBIOSServices
  1226.     RETURN
  1227.     END SUB
  1228.     '=========================================================================
  1229.     SUB ReturnLine STATIC
  1230.     '=========================================================================
  1231.     DEFINT A-Z
  1232.         SubnumSave = Subnum
  1233.         Subnum = 68
  1234.     CALL ReturnLineDelete
  1235.     CALL ShowIt(N7, N24, N62, " Return ")
  1236.     CALL ShowIt(N6, N0, Nm1, "Proceed")
  1237.         Subnum = SubnumSave
  1238.     END SUB
  1239.     '=========================================================================
  1240.     SUB ReturnLineDelete STATIC
  1241.     '=========================================================================
  1242.     DEFINT A-Z
  1243.         SubnumSave = Subnum
  1244.         Subnum = 69
  1245.     CALL ShowErase(N6, N24, N62, N19, Blank0$)
  1246.         Subnum = SubnumSave
  1247.     END SUB
  1248.     '=========================================================================
  1249.     SUB SaveCurrentDirectory (EntryPoint) STATIC
  1250.     '=========================================================================
  1251.     '   Store User or Calendar's Current Directory
  1252.     DEFINT A-Z
  1253.         SubnumSave = Subnum
  1254.         Subnum = 70
  1255.     '-----------------------------------------------------------
  1256.     '   Get User or Calendar Directory
  1257.     DirectoryGet$ = SPACE$(65)
  1258.     DriveGet = N0
  1259.     CALL MhDir(N1%, DriveGet%, DirectoryGet$, Ecode%)
  1260.     IF Ecode THEN ERROR 255
  1261.     '-------------------------------------------------------------------------
  1262.     GetPath$ = RTRIM$(CHR$(N64 + DriveGet) + ":\" + ASCIIN$(DirectoryGet$))
  1263.     DirectoryGet$ = ASCIIZ$(GetPath$)
  1264.     '-------------------------------------------------------------------------
  1265.     IF EntryPoint THEN
  1266.         DriveReturn = DriveGet
  1267.         DirectoryReturn$ = DirectoryGet$
  1268.         ReturnPath$ = GetPath$
  1269.       ELSE
  1270.         DriveUser = DriveGet
  1271.         DirectoryUser$ = DirectoryGet$
  1272.         UserPath$ = GetPath$
  1273.     END IF
  1274.         Subnum = SubnumSave
  1275.     END SUB
  1276.     '=========================================================================
  1277.     SUB SaveDOSKeyState STATIC
  1278.     '=========================================================================
  1279.     '  Save DOS Keystate
  1280.     DEFINT A-Z
  1281.         SubnumSave = Subnum
  1282.         Subnum = 71
  1283.     '----------------------------------
  1284.     '  Determine number of display rows and columns
  1285.     CALL MhDisplay (DispMode%, UserColumns%, UserRows%, Memory%, _
  1286.         DisplayType%)
  1287.     DisplayColumns = UserColumns
  1288.     DisplayRows = UserRows
  1289.     '----------------------------------
  1290.     '  Get the state of the insert, caps, num, and scroll keys
  1291.     CALL MhGetKbStatus1(InsertDOS%, CapsDOS%, NumDOS%, ScrollDOS%, _
  1292.         Alt%, Ctrl%, Left%, Right%)
  1293.     '----------------------------------
  1294.     ' ROM-BIOS Video Services Interrupt
  1295.     ' Get Cursor, mode, and page Information
  1296.     '   First Determine the user's video page and mode.
  1297.     InterruptNumber% = &H10            ' Video Services
  1298.     AH% = &H0F                    ' Get User's Video Page and mode
  1299.     GOSUB DOSBIOS2
  1300.     UserMode = AL%                    ' Save user video mode
  1301.     CurrentVideoMode = AL%            '  and set it as current
  1302.     DOSCursorPage = BH%                ' Save user video page
  1303.     CurrentVideoPage = BH%            '  and set it as current
  1304.     '----------------------------------
  1305.     InterruptNumber% = &H10            ' Video Services
  1306.     AH% = &H3                        ' Read Cursor Information
  1307.     GOSUB DOSBIOS2
  1308.     '    On return, this is what the registers contain:
  1309.     '    CH=Cursor start line, CL=Cursor end line
  1310.     '    DH=Cursor Row (base 0), DL=Cursor column (base 0)
  1311.     '----------------------------------
  1312.     DOSCursorRow = N1 + DH%            ' Save user cursor row
  1313.     DOSCursorColumn = N1 + DL%        ' Save user cursor column
  1314.     '  Mask Cursor Start Scan Line Bits
  1315.     DOSCursorStart = CH% AND N15        ' Save user cursor top scan line
  1316.     DOSCursorStop = CL%                ' Save user cursor bottom scan line
  1317.     DOSCursorBit = CH% AND N32         ' Isolate user Cursor On/Off Bit
  1318.     ' Test for Cursor Off
  1319.     IF DOSCursorBit = N32 THEN        ' Save state of user cursor
  1320.         DOSCursorState = N0
  1321.       ELSE
  1322.         DOSCursorState = N1
  1323.     END IF
  1324.     '----------------------------------
  1325.     '  This is the *only* safe place to turn the user cursor off, as we're
  1326.     '  in the underlying program's video mode and page, here.  BASIC
  1327.     '  statements don't know anything about this mode and page, so we use
  1328.     '  direct DOS video functions to accomplish this.
  1329.     AH% = &H01                    ' Set Cursor Size function
  1330.     CL% = DOSCursorStop                ' turn user cursor off
  1331.     CH% = DOSCursorStart
  1332.     CH% = CH% AND NOT N32            '  and turn it off
  1333.     GOSUB DOSBIOS2
  1334.     '----------------------------------
  1335.     DOSColor = SCREEN(N1, N1, N1)        ' save DOS Colors
  1336.     CALL ColorDecode(DOSColor)        ' (not sure this is save in all
  1337.     DOSForeground = ColorForeground    '  modes, so looking into a replacement
  1338.     DOSBackground = ColorBackground    '  for the BASIC SCREEN function.)
  1339.     '
  1340.         Subnum = SubnumSave
  1341.     EXIT SUB
  1342. DOSBIOS2:
  1343.     CALL DOSBIOSServices
  1344.     RETURN
  1345.     END SUB
  1346.     '=========================================================================
  1347.     SUB ScreenBottoms STATIC
  1348.     '=========================================================================
  1349.     DEFINT A-Z
  1350.         SubnumSave = Subnum
  1351.         Subnum = 72
  1352.     IF NOT NewGuy AND NOT SrAutoOptions THEN
  1353.         CALL PopLine
  1354.     END IF
  1355.     CALL EscapeLine
  1356.     CALL ReturnLine
  1357.     CALL QuitLine
  1358.         Subnum = SubnumSave
  1359.     END SUB
  1360.     '=========================================================================
  1361.     SUB ScreenBottomsDelete STATIC
  1362.     '=========================================================================
  1363.     DEFINT A-Z
  1364.         SubnumSave = Subnum
  1365.         Subnum = 73
  1366.     CALL PopLineDelete
  1367.     CALL EscapeLineDelete
  1368.     CALL ReturnLineDelete
  1369.         Subnum = SubnumSave
  1370.     END SUB
  1371.     '=========================================================================
  1372.     SUB SequenceEventsTable STATIC
  1373.     '=========================================================================
  1374.     '   Resequence Event Table When Alarm Rings Or After Event Editing
  1375.     DEFINT A-Z
  1376.         SubnumSave = Subnum
  1377.         Subnum = 65
  1378.     IF EventTableStable THEN GOTO ExitPoint3
  1379.     '-------------------------------------------------------------------------
  1380. NormalAlarmBuild:
  1381.     ' Read the Event List.  Decide To Resequence Only If needed.
  1382.     '-------------------------------------------------------------------------
  1383.     IF ClockScreen THEN 
  1384.         RefreshInstructions = Yes
  1385.     END IF
  1386.     CALL ShowErase(N14, N25, N1, N80, SPACE$(N21) + _
  1387.         "Please Wait--Building Alarm List")
  1388.     SchCnt$ = Blank8$
  1389.     RedisplayNotesEvents = Yes
  1390.     EventsScheduled = N0
  1391.     HeldDateTime# = 0#
  1392.     Badrec = No
  1393.     ExistingNullrec = No
  1394.     TimerSave! = TIMER
  1395.     '-------------------------------------------------------------------------
  1396.     FOR WhichEvent = N1 TO NumberofEvents
  1397.         CALL KeyStuff(KeyStatus)
  1398.         CALL MhIntToString(SchCnt$, (NumberofEvents% + N1% - WhichEvent%))
  1399.         CALL ShowIt(N14, N25, N60, SchCnt$)
  1400.         '--------------------------------------------------------------------
  1401.         '  Blink Event Table Initialize
  1402.         PendingEvents(WhichEvent) = N0
  1403.         '--------------------------------------------------------------------
  1404.         RecordPointer = N1 + WhichEvent
  1405.         ' Get Next Record--Sets Contents in CurrentEventRecord$
  1406.         CALL GetApptRecord(RecordPointer)
  1407.         '--------------------------------------------------------------------
  1408.         ' Test if Blanks In The Sequence--If So, Sets Resort Flag
  1409.         IF CurrentEventRecord$ = Blank80$ THEN
  1410.             ExistingNullrec = Yes
  1411.             GOTO NextRecord
  1412.         END IF
  1413.         '--------------------------------------------------------------------
  1414.         '  Non-Blank Record
  1415.         '--------------------------------------------------------------------
  1416.         '  Set Null Record If There Is One For Test
  1417.         IF ExistingNullrec THEN
  1418.             ' There was a blank record in the middle of non-blank ones
  1419.             Badrec = Yes
  1420.         END IF
  1421.         '--------------------------------------------------------------------
  1422.         ' Very Old file format didn't have the year
  1423.         'Fill In "19" In Record For Dates Which Don't Already Have It
  1424.         IF MID$(CurrentEventRecord$, N74, N2) = Blank2$ THEN 
  1425.             CALL Myd2(CurrentEventRecord$, N74, N2, "19")
  1426.         END IF
  1427.         '---------------------------------------------------------------
  1428.         '  Construct the Event Date/Time for Validation
  1429.         CALL MhMidString(EventDateTime$, N1%,  N2%, CurrentEventRecord$, N74%)
  1430.         CALL MhMidString(EventDateTime$, N3%, N10%, CurrentEventRecord$, N1%)
  1431.         '---------------------------------------------------------------
  1432.         ' Check for bad records (missing numerics, out of sequence)
  1433.         IF NumberError(EventDateTime$) THEN
  1434.             '  Non-numeric and non-blank
  1435.             ' blank out, write history, set flag to resort
  1436.             EventtoHistory = No
  1437.             HistoryBuffer$ = CurrentEventRecord$
  1438.             CALL WritetoHistory
  1439.             CALL MhLset(ApptBuffer$, Blank80$)
  1440.             CALL PutApptRecord(RecordPointer)
  1441.             Badrec = Yes
  1442.             GOTO NextRecord
  1443.         END IF
  1444.         '---------------------------------------------------------------
  1445.         '     Good Record, Go On
  1446.         CombinedDateTime# = VAL(EventDateTime$)
  1447.         IF CombinedDateTime# > 0# AND _
  1448.            CombinedDateTime# < HeldDateTime# THEN
  1449.             ' Out-of-sequence but good record                
  1450.             Badrec = Yes
  1451.         END IF
  1452.         HeldDateTime# = CombinedDateTime#
  1453.         '---------------------------------------------------------------
  1454.         ' Bump Next Valid Slot Number
  1455.         EventsScheduled = EventsScheduled + N1
  1456.         '---------------------------------------------------------------
  1457.         ' Save Alarm Value In That Slot
  1458.         Alarms(EventsScheduled).Alarm = CombinedDateTime#
  1459.         ' In Case We Need To Sort, Save Appt File Position
  1460.         Alarms(EventsScheduled).Sequence = WhichEvent
  1461.         '  Build Alarms(x).Warning
  1462.         IF Pending THEN
  1463.             '  Skip warning and blink table if not desired
  1464.             CALL ComputePendingValue(Alarms(EventsScheduled).Alarm, _
  1465.                 Alarms(EventsScheduled).Warning)
  1466.         END IF
  1467.         '---------------------------------------------------------------
  1468.         ' Cancel Automatic Pop Down if Alarm or Warning coming            
  1469.         IF ((Pending AND Alarms(WhichEvent).Warning <= CurrentDateTime#) OR _
  1470.             (Alarms(WhichEvent).Alarm <= CurrentDateTime#)) AND _
  1471.              SrAutoPopDown AND NOT SrAutoPopDownHappened         THEN
  1472.             '----------------------------------------------------------
  1473.             SrAutoPopDownHappened = Yes
  1474.             IF AutoStarted THEN
  1475.                 CALL MinorBeeper
  1476.                 CALL ShowIt(N15, N16, Nm2, _
  1477.         " ... and Automatic Pop Down Has Been Requested, But Cancelled! ")
  1478.             END IF
  1479.         END IF
  1480. NextRecord:
  1481.     '--------------------------------------------------------------------
  1482.     NEXT
  1483.     '-------------------------------------------------------------------------
  1484.     ' At this point, an Alarm List is built, with warning times if Pending
  1485.     '  is non-zero.  If either blank records were found inbetween the good 
  1486.     '  ones, or if the records contained bad data or were out of time
  1487.     '  sequence, the list is resorted and rewritten to the appt file.  Else
  1488.     '  we get out here.  Note that Alarms(I) may be more compressed than the
  1489.     '  state of the file; this would require sorting.
  1490.     '  In either case, EventsScheduled is solid at this point.
  1491.     '  Of course, there may be nothing to do also.    
  1492.     '-------------------------------------------------------------------------
  1493.     IF NOT Badrec AND NOT EventsScheduled THEN
  1494.         GOTO FinishedSequence
  1495.     END IF
  1496.     '-------------------------------------------------------------------------
  1497. StartSequencing:
  1498.     '--------------------------------------------------------------------
  1499.     '  Sort Phase 1 -- Sort the Alarms(I) Array
  1500.     '-------------------------------------------------------------------------
  1501.     ExitKeys = No                    ' Keep Program from Exiting Prematurely
  1502.     '-------------------------------------------------------------------------
  1503.     IF EventsScheduled > N1 THEN        ' Don't Sort Only One Event
  1504.         '--------------------------------------------------------------------
  1505.         '  Sort the Alarms(I) Array.  Note that this also sorts the warning
  1506.         '  values (.Warning) AND the appt file position records (.Sequence)
  1507.         CALL ShowErase(N14, N25, N1, N80, (SPACE$(N21) + _
  1508.             "Please Wait--Sorting Alarm List"))
  1509.         '--------------------------------------------------------------------
  1510.         '  Use Microsoft's Incredibly Fast Sort Algorithm from QB 4.50
  1511.         SortLow = N1
  1512.         SortHigh = EventsScheduled
  1513.         CALL QuickSort(SortLow, SortHigh)        ' Sort Alarm Table
  1514.     END IF
  1515.     '--------------------------------------------------------------------
  1516.     '  Sort Phase 2 -- Build Temporary File of Sorted Events
  1517.     '--------------------------------------------------------------------
  1518.     ' Open Temporary Event Hold File
  1519.     CALL KillAFile(ApptFilename$ + ".cls")    ' Start Fresh!
  1520.     OPEN "R", #FilenumApptSort, ApptFilename$ + ".cls", N80
  1521.     FIELD #FilenumApptSort, N80 AS TempApptBuffer$
  1522.     '--------------------------------------------------------------------
  1523.     CALL ShowErase(N14, N25, N1, N80, (SPACE$(N21) + _
  1524.         "Please Wait--Building Sorted Events"))
  1525.     SchCnt$ = Blank8$
  1526.     EventPosition = N0
  1527.     '--------------------------------------------------------------------
  1528.     FOR I = N1 TO EventsScheduled
  1529.         CALL MhIntToString(SchCnt$, (EventsScheduled% - I% + N1%))
  1530.         CALL ShowIt(N14, N25, N60, SchCnt$)
  1531.         ' No point in doing KeyStuff When ExitKeys is Off--Slows Us Down
  1532.         '---------------------------------------------------------------
  1533.         ' Get the old record
  1534.         EventPosition = EventPosition + N1
  1535.         GET #FilenumAppt, N1 + Alarms(I).Sequence
  1536.         CALL MhLset(TempApptBuffer$, ApptBuffer$)
  1537.         ' Write it to the new position in the temporary file
  1538.         PUT #FilenumApptSort, EventPosition
  1539.         '---------------------------------------------------------------
  1540.     NEXT
  1541.     '--------------------------------------------------------------------
  1542.     '  Sort Phase 3 -- Rewrite Temporary File to Appointment File
  1543.     '--------------------------------------------------------------------
  1544.     CALL ShowErase(N14, N25, N1, N80, (SPACE$(N21) + _
  1545.         "Please Wait--Resaving Event List"))
  1546.     SchCnt$ = Blank8$
  1547.     FOR I = N1 TO NumberofEvents
  1548.     '--------------------------------------------------------------------
  1549.         '  Note that ENTIRE file is written, not just EventsScheduled
  1550.         '---------------------------------------------------------------
  1551.         CALL MhIntToString(SchCnt$, (NumberofEvents% - I% + N1%))
  1552.         CALL ShowIt(N14, N25, N60, SchCnt$)
  1553.         ' Copy Sorted List Back to Appointment File            
  1554.         IF I <= EventsScheduled THEN
  1555.             GET #FilenumApptSort, I
  1556.             CALL MhLset(ApptBuffer$, TempApptBuffer$)
  1557.           ELSE
  1558.             CALL MhLset(ApptBuffer$, Blank80$)
  1559.         END IF
  1560.         CALL PutApptRecord(N1 + I)
  1561.     NEXT
  1562.     '--------------------------------------------------------------------
  1563.     CLOSE #FilenumApptSort
  1564.     CALL KillAFile(ApptFilename$ + ".cls")
  1565.     '--------------------------------------------------------------------
  1566.     '    Done
  1567.     '--------------------------------------------------------------------
  1568. FinishedSequence:
  1569.     IF ClockScreen THEN
  1570.         CALL Kolors(N3)
  1571.       ELSEIF OnEditPage THEN 
  1572.         CALL Kolors(N5)
  1573.       ELSE
  1574.         CALL Kolors(N6)
  1575.     END IF
  1576.     CALL ShowIt(N0, N25, N1, Blank80$)
  1577.     '  Flush I/O Buffers for Safety By Closing and Opening File
  1578.     CALL OpenAppts                     
  1579.     EventTableStable = Yes
  1580.     ExitKeys = Yes
  1581. ExitPoint3:
  1582.         Subnum = SubnumSave
  1583.     END SUB
  1584.     '=========================================================================
  1585.     SUB SetArrays STATIC
  1586.     '=========================================================================
  1587.     DEFINT A-Z
  1588.         SubnumSave = Subnum
  1589.         Subnum = 74
  1590.     '  Set/Change Definitions Based Upon Event Table Size
  1591.     NumberofEvents = N20 * InString(ValidSizes$, EventSizeCode$)
  1592.     IF NumberofEvents <> EventTableSize THEN
  1593.         EventTableSize = NumberofEvents
  1594.         EventTableStable = No
  1595.         TimerSave! = TIMER
  1596.     END IF
  1597.     NumberofNotes = N20 * InString(ValidSizes$, NoteSizeCode$)
  1598.     OldNumberEvents = NumberofEvents
  1599.     OldNumberNotes = NumberofNotes
  1600.     '  Redefine Appt File Pointers
  1601.     StartingNote = N2 + NumberofEvents
  1602.     StartingHistory = N2 + NumberofEvents + NumberofNotes
  1603.         Subnum = SubnumSave
  1604.     END SUB
  1605.     '=========================================================================
  1606.     SUB SetColors STATIC
  1607.     '=========================================================================
  1608.     DEFINT A-Z
  1609.         SubnumSave = Subnum
  1610.         Subnum = 75
  1611.     ColorError = N0
  1612.     FOR ColorPair = N1 TO N7
  1613.         '  Initialize Screen With Current Colors
  1614. DetermineWhichPair:
  1615.         SELECT CASE ColorPair
  1616.             CASE 1
  1617.                 CALL Kolors(N1)
  1618.                 Csav1 = Cl1f
  1619.                 Csav2 = Cl1b
  1620.             CASE 2
  1621.                 CALL Kolors(N2)
  1622.                 Csav1 = Cl2f
  1623.                 Csav2 = Cl2b
  1624.             CASE 3
  1625.                 CALL Kolors(N3)
  1626.                 Csav1 = Cl3f
  1627.                 Csav2 = Cl3b
  1628.             CASE N4
  1629.                 CALL Kolors(N4)
  1630.                 Csav1 = Cl4f
  1631.                 Csav2 = Cl4b
  1632.             CASE N5
  1633.                 CALL Kolors(N5)
  1634.                 Csav1 = Cl5f
  1635.                 Csav2 = Cl5b
  1636.             CASE 6
  1637.                 CALL Kolors(N6)
  1638.                 Csav1 = Cl6f
  1639.                 Csav2 = Cl6b
  1640.             CASE 7
  1641.                 CALL Kolors(N7)
  1642.                 Csav1 = Chf
  1643.                 Csav2 = Chb
  1644.         END SELECT
  1645.         CALL ClearScreenNormal(N1)
  1646.         ScreenTitles$(N1) = " Change " + ColorPairUses$(ColorPair) + _
  1647.                         " Color  (Screen" + STR$(ColorPair) + " of 7)"
  1648.         CALL Titles(Nm1)
  1649.         IF ColorError THEN
  1650.             CALL MajorBeeper
  1651.             KolorSet = N18
  1652.             GOSUB WarningOrBlanking
  1653.             ColorError = N0
  1654.         END IF
  1655.         CALL ShowIt(N6, N23, N1, "(Note: 8-Color Monitors Show No  ")
  1656.         CALL ShowIt(N0, Nm1, N0, " Difference Between The 1st 8    ")
  1657.         CALL ShowIt(N0, Nm1, N0, " And The 2nd 8 Foreground Colors)")
  1658.         FOR ColorPairType = N1 TO N2
  1659.             ' Calculate Displacements Based On Which Color Is Being Changed
  1660.             XCL = N16 + 35 * (ColorPairType - N1)
  1661.             WhichColor = (ColorPair - N1) * N2 + ColorPairType
  1662.             IF ColorPairType = N1 THEN
  1663.                 ListSize = N16
  1664.               ELSE
  1665.                 ListSize = N8
  1666.             END IF
  1667.             '  Fill 16 Color List for Foreground, 8 for Background
  1668.             FOR Clist = N1 TO ListSize
  1669.                 MenuLines(Clist) = Colors$(Clist)
  1670.             NEXT Clist
  1671.             '  Get Current Color Choice
  1672.             '   Store Currently Chosen Colors For Menu
  1673.             SELECT CASE WhichColor
  1674.                 CASE 1
  1675.                     ColorChoices(WhichColor) = Cl1f
  1676.                     MenuColorBack = Cl1b
  1677.                 CASE 2
  1678.                     ColorChoices(WhichColor) = Cl1b
  1679.                     MenuColorBack = Cl1f
  1680.                 CASE 3
  1681.                     ColorChoices(WhichColor) = Cl2f
  1682.                     MenuColorBack = Cl2b
  1683.                 CASE N4
  1684.                     ColorChoices(WhichColor) = Cl2b
  1685.                     MenuColorBack = Cl2f
  1686.                 CASE N5
  1687.                     ColorChoices(WhichColor) = Cl3f
  1688.                     MenuColorBack = Cl3b
  1689.                 CASE 6
  1690.                     ColorChoices(WhichColor) = Cl3b
  1691.                     MenuColorBack = Cl3f
  1692.                 CASE 7
  1693.                     ColorChoices(WhichColor) = Cl4f
  1694.                     MenuColorBack = Cl4b
  1695.                 CASE N8
  1696.                     ColorChoices(WhichColor) = Cl4b
  1697.                     MenuColorBack = Cl4f
  1698.                 CASE N9
  1699.                     ColorChoices(WhichColor) = Cl5f
  1700.                     MenuColorBack = Cl5b
  1701.                 CASE N10
  1702.                     ColorChoices(WhichColor) = Cl5b
  1703.                     MenuColorBack = Cl5f
  1704.                 CASE N11
  1705.                     ColorChoices(WhichColor) = Cl6f
  1706.                     MenuColorBack = Cl6b
  1707.                 CASE N12
  1708.                     ColorChoices(WhichColor) = Cl6b
  1709.                     MenuColorBack = Cl6f
  1710.                 CASE N13
  1711.                     ColorChoices(WhichColor) = Chf
  1712.                     MenuColorBack = Chb
  1713.                 CASE N14
  1714.                     ColorChoices(WhichColor) = Chb
  1715.                     MenuColorBack = Chf
  1716.             END SELECT
  1717.             MenuColorFore = ColorChoices(WhichColor)
  1718.             ColorForeground = MenuColorFore
  1719.             ColorBackground = MenuColorBack
  1720.             CALL Kolors(N0)                          ' Special Colors
  1721.             CALL ShowIt(N0, N4, XCL + N1, (ColorPairTypes$(ColorPairType)))
  1722.             '  Display Menu For Change
  1723.             MenuChoice = N1 + ColorChoices(WhichColor)
  1724.             IF ColorPairType = N1 THEN
  1725.                 ColorSave1 = MenuChoice - N1
  1726.               ELSE
  1727.                 ColorSave2 = MenuChoice - N1
  1728.             END IF
  1729.             CALL MenuDriver(ListSize, MenuChoice, N5, XCL, _
  1730.                 MenuSingleLine, N0, N1, N1)
  1731.             ColorForeground = Csav1
  1732.             ColorBackground = Csav2
  1733.             KolorSet = N6
  1734.             GOSUB WarningOrBlanking          '  Delete Error Message
  1735.             '  Normal Out On Beginning of Pair
  1736.             IF MenuExit = MenuCancelled AND ColorPairType = N1 THEN
  1737.                 GOTO RewriteColorFile
  1738.             END IF
  1739.             '  Out Before End of Pair Compares With Previous Value
  1740.             '  Set the Changed Color
  1741.             ColorChoices(WhichColor) = MenuChoice - N1
  1742.             '  Re-Establish Color Setting From Menu Choice
  1743.             GOSUB SaveChangedColor
  1744.         NEXT ColorPairType
  1745.         '   Reject Pairs Which Are Equal
  1746.         ColorError = N0
  1747.         IF ColorChoices(WhichColor) = ColorChoices(WhichColor - N1) THEN
  1748.             ColorError = N1
  1749.             ColorChoices(WhichColor) = ColorSave2
  1750.             GOSUB SaveChangedColor
  1751.             WhichColor = WhichColor - N1
  1752.             ColorChoices(WhichColor) = ColorSave1
  1753.             GOSUB SaveChangedColor
  1754.             GOTO DetermineWhichPair
  1755.           ELSEIF MenuExit = MenuCancelled THEN
  1756.             EXIT FOR
  1757.         END IF
  1758.     NEXT ColorPair
  1759. RewriteColorFile:
  1760.     WhichColor = N0
  1761.     CALL WriteCalfig
  1762.     CALL ClearScreenNormal(N1)
  1763.     CALL DirectReturnCheck
  1764.     GOTO ExitPoint4
  1765.     '           Rewrite
  1766. SaveChangedColor:
  1767.     SELECT CASE WhichColor             '  Save Changed Color From Menu
  1768.         CASE 1
  1769.             Cl1f = ColorChoices(WhichColor)
  1770.         CASE 2
  1771.             Cl1b = ColorChoices(WhichColor)
  1772.         CASE 3
  1773.             Cl2f = ColorChoices(WhichColor)
  1774.         CASE N4
  1775.             Cl2b = ColorChoices(WhichColor)
  1776.         CASE 5
  1777.             Cl3f = ColorChoices(WhichColor)
  1778.         CASE 6
  1779.             Cl3b = ColorChoices(WhichColor)
  1780.         CASE 7
  1781.             Cl4f = ColorChoices(WhichColor)
  1782.         CASE N8
  1783.             Cl4b = ColorChoices(WhichColor)
  1784.         CASE N9
  1785.             Cl5f = ColorChoices(WhichColor)
  1786.         CASE N10
  1787.             Cl5b = ColorChoices(WhichColor)
  1788.         CASE N11
  1789.             Cl6f = ColorChoices(WhichColor)
  1790.         CASE N12
  1791.             Cl6b = ColorChoices(WhichColor)
  1792.         CASE N13
  1793.             Chf = ColorChoices(WhichColor)
  1794.         CASE N14
  1795.             Chb = ColorChoices(WhichColor)
  1796.     END SELECT
  1797.     RETURN
  1798.     '-------------------------------------------------------------------------
  1799. WarningOrBlanking:
  1800.     CALL Kolors(KolorSet)                   ' Warning or blanking color
  1801.     ' Blank Error Area
  1802.     CALL ShowMult(N0, N7, N62, N19, N4)          ' Box for message or erase it
  1803.     ' Print Error Message
  1804.     IF KolorSet <> N6 THEN
  1805.         CALL ShowIt(N0, N0, N0, " Background and    ")
  1806.         CALL ShowIt(N0, Nm1, N0, " foreground colors ")
  1807.         CALL ShowIt(N0, Nm1, N0, " must be different ")
  1808.         CALL ShowIt(N0, Nm1, N0, "  -- try again !!  ")
  1809.     END IF
  1810.     RETURN
  1811.     '-------------------------------------------------------------------------
  1812. ExitPoint4:
  1813.         Subnum = SubnumSave
  1814.     END SUB
  1815.     '=========================================================================
  1816.     SUB SetCurrentDirectory (EntryPoint) STATIC
  1817.     '=========================================================================
  1818.     '    Sets Calendar's, User's, or Swap Path's Directory
  1819.     DEFINT A-Z
  1820.         SubnumSave = Subnum
  1821.         Subnum = 76
  1822.     '-------------------------------------------------------------------------
  1823.     SELECT CASE EntryPoint
  1824.         CASE 0                             ' User's Directory
  1825.             DirectorySet$ = DirectoryUser$
  1826.             DriveSet = DriveUser
  1827.         CASE 1                             ' Calendar's Directory
  1828.             DirectorySet$ = DirectoryReturn$
  1829.             DriveSet = DriveReturn
  1830.         CASE 2                             ' Disk Swap Directory
  1831.             DirectorySet$ = SrSwapPath$ + CHR$(N0)
  1832.             DriveSet = InString(LEFT$(PathLegalChars$, N26), _
  1833.                           LEFT$(SrSwapPath$, N1))
  1834.     END SELECT
  1835.     CALL MhDir(N2%, DriveSet%, DirectorySet$, Ecode%)     ' Set
  1836.     IF Ecode AND EntryPoint <> N2 THEN 
  1837.         ERROR 255
  1838.     END IF
  1839.         Subnum = SubnumSave
  1840.     END SUB                                             ' Drive and Directory
  1841.     '========================================================================
  1842.     '========================  END OF CAL5.BAS  =============================
  1843.     '========================================================================
  1844.